home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 34.zip / BS1 part 34 / FredFish PD 308.adf / StarBlanker / src / Blanker.mod next >
Text File  |  1990-01-18  |  9KB  |  327 lines
  1. MODULE Blanker;
  2.  
  3. (*======================================================================*)
  4. (*                        StarBlanker v1.0                              *)
  5. (*======================================================================*)
  6. (*    Copyright (c) 1989, 1990 Chris Bailey, All Rights Reserved        *)
  7. (*======================================================================*)
  8. (*      Version: 1.00           Author : Chris Bailey                   *)
  9. (*      Date   : 04-Jan-90                                              *)
  10. (*======================================================================*)
  11. (*  Distribution of this code is limited to the terms expressed in the  *)
  12. (*  documentation of this program.                                      *)
  13. (*======================================================================*)
  14. (*  Contents : Input handler, startup code for StarBlanker        *)
  15. (*======================================================================*)
  16.  
  17. FROM SYSTEM       IMPORT ADR, ADDRESS, TSIZE, SETREG, SAVEREGS, LOADREGS,
  18.                   REGISTER, BYTE, STRPTR, CODE, LONGWORD;
  19. FROM CmdLineUtils  IMPORT argc, argv;
  20. FROM Mess       IMPORT SayMessage;
  21.  
  22. (* You could replace this with a blanker function of your own design *)
  23. FROM StarBlanker   IMPORT DoStarBlank;
  24.  
  25. FROM Interrupts       IMPORT Interrupt, Forbid, Permit;
  26. FROM Devices       IMPORT OpenDevice, CloseDevice;
  27. FROM InputEvents   IMPORT InputEventPtr, IEClass, IEQualifiers, IEQualifierSet,
  28.               InputEvent;
  29. FROM IO           IMPORT IOStdReq, DoIO;
  30. FROM InputDevice   IMPORT INDAddHandler, INDRemHandler;
  31. FROM PortUtils       IMPORT CreatePort, DeletePort;
  32. FROM ConsoleDevice IMPORT RawKeyConvert, ConsoleName, ConsoleBase;
  33. FROM Ports       IMPORT MsgPortPtr, FindPort;
  34. FROM Tasks       IMPORT Wait, Signal, SignalSet, AllocSignal, FreeSignal,
  35.               TaskPtr, FindTask;
  36. FROM RunTime       IMPORT CurrentProcess, WBMsg;
  37. FROM Intuition       IMPORT ScreenPtr, CurrentTime;
  38. FROM TimerDevice   IMPORT TimeVal;
  39. FROM DOS       IMPORT SIGBreakC, FileLock, CurrentDir;
  40. FROM Workbench      IMPORT WBStartupPtr, WBArgPtr, WBArg, DiskObjectPtr;
  41. FROM Icon      IMPORT GetDiskObject, FreeDiskObject, IconName, IconBase,
  42.              FindToolType;
  43. FROM Libraries      IMPORT OpenLibrary, CloseLibrary;
  44.  
  45. CONST 
  46.   TASKNAME = "* Blanker";    (* The name of our task, also in RTD.mod *)
  47.   PORTNAME = "* Blank_Port";    (* The name of our port             *)
  48.  
  49.   DEFAULTTIMEOUT  = 4*60;        
  50.   MINTIMEOUT      = 10;
  51.   (* Timeout in Seconds *)
  52.  
  53. TYPE IEClassSet = SET OF IEClass; (* Because there isn't one in the .DEF *)
  54.  
  55. VAR
  56.   ioreq    : IOStdReq;
  57.   maintask : TaskPtr;
  58.   port     : MsgPortPtr;
  59.   sigbit,sigbit2 : CARDINAL;
  60.   int      : Interrupt;
  61. VAR
  62.   iostdreq : IOStdReq;
  63.  
  64.   ourtime  : TimeVal;
  65.   timeout  : LONGCARD;
  66.  
  67. (*$X,$S-*)
  68. PROCEDURE LengthStr(str:ARRAY OF CHAR): CARDINAL;
  69. BEGIN
  70.   CODE(0265FH,0205FH,0321FH,070FFH,05280H,04A18H,06704H,0B041H,06FF6H,
  71.        04ED3H);
  72.  
  73. END LengthStr;
  74.  
  75. (*$S-*)
  76. PROCEDURE StrToNum(str:ARRAY OF CHAR; VAR num:LONGWORD): BOOLEAN;
  77. VAR
  78.   negate         : BOOLEAN;
  79.   lbase,newnum   : LONGCARD;
  80.   length,i       : CARDINAL;
  81.   digit          : INTEGER;
  82. BEGIN
  83.     length:=LengthStr(str);
  84.     i:=0;
  85.     newnum:=0;
  86.     negate:=FALSE;
  87.     lbase:=10;
  88.  
  89.     (* Skip leading blanks *)
  90.     WHILE str[i]=" " DO
  91.       INC(i);
  92.     END;
  93.  
  94.     IF i>length THEN
  95.       RETURN FALSE;
  96.     END;
  97.  
  98.     WHILE (i<length) DO
  99.       digit:=ORD(CAP(str[i]));
  100.       IF digit>=INTEGER(ORD("A")) THEN
  101.         DEC(digit,7);
  102.       END;
  103.       DEC(digit,48);
  104.  
  105.       IF (digit<0) OR (digit>=INTEGER(lbase)) THEN
  106.         RETURN FALSE;
  107.       END;
  108.  
  109.       (* Make sure we don't get an overflow *)
  110.       IF (negate) & ((MAX(LONGINT)-LONGINT(digit)) DIV LONGINT(lbase) < LONGINT(newnum)) THEN
  111.         RETURN FALSE;
  112.       END;
  113.       IF (MAX(LONGCARD)-LONGCARD(digit)) DIV lbase < newnum THEN
  114.         RETURN FALSE;
  115.       END;
  116.  
  117.       newnum:=newnum*lbase+LONGCARD(digit);
  118.       INC(i);
  119.     END;
  120.  
  121.     (* Flip the sign if needed *)
  122.     num:=newnum;
  123.     IF negate THEN
  124.       num:=-LONGINT(newnum);
  125.     END;
  126.  
  127.     RETURN TRUE;
  128. END StrToNum;
  129.  
  130. PROCEDURE SetTimeOut(str : STRPTR);
  131. BEGIN
  132.   IF str # NIL THEN
  133.     IF ~StrToNum(str^,timeout) THEN
  134.       timeout := DEFAULTTIMEOUT;
  135.     ELSE
  136.       IF (timeout < MINTIMEOUT) THEN
  137.         timeout := DEFAULTTIMEOUT;
  138.       END;
  139.     END;
  140.   ELSE
  141.     timeout := DEFAULTTIMEOUT;
  142.   END;
  143. END SetTimeOut;
  144.  
  145. PROCEDURE GetToolTypes(wbArg:WBArgPtr);
  146. VAR
  147.   diskObj : DiskObjectPtr;
  148.   str     : STRPTR;
  149. BEGIN
  150.   IconBase:=OpenLibrary(ADR(IconName),0);
  151.   IF IconBase=NIL THEN
  152.     timeout := DEFAULTTIMEOUT;
  153.     RETURN;
  154.   END;
  155.  
  156.   (* Load the icon associated with the argument *)
  157.   diskObj:=GetDiskObject(wbArg^.waName);
  158.   IF diskObj=NIL THEN
  159.     timeout := DEFAULTTIMEOUT;
  160.     RETURN;
  161.   END;
  162.  
  163.   str := FindToolType(diskObj^.doToolTypes,ADR("TIMEOUT"));
  164.   SetTimeOut(str);
  165.   
  166.   (* Free the icon we loaded *)
  167.   FreeDiskObject(diskObj);
  168.   
  169.   CloseLibrary(IconBase);
  170. END GetToolTypes;
  171.  
  172. PROCEDURE HandleWBStartup();
  173. VAR wbmsg    : WBStartupPtr;
  174.     wbargcnt : CARDINAL;
  175.     wbarg    : WBArgPtr;
  176.     lock     : FileLock;
  177. BEGIN
  178.     wbmsg:=WBMsg;
  179.     wbargcnt:=wbmsg^.smNumArgs;
  180.     wbarg:=wbmsg^.smArgList;
  181.  
  182.   lock:=CurrentDir(wbarg^.waLock);
  183.  
  184.   GetToolTypes(wbarg);
  185.  
  186.   (* Reset current directory to what it was *)
  187.   lock:=CurrentDir(lock);
  188.  
  189. END HandleWBStartup;
  190.  
  191. PROCEDURE Startup();
  192. BEGIN
  193.   CASE argc OF
  194.    | 0 : HandleWBStartup();
  195.    | 2 : SetTimeOut(argv[1]);
  196.   ELSE
  197.     timeout := DEFAULTTIMEOUT;
  198.   END;
  199. END Startup;
  200.  
  201. PROCEDURE InputHandler() : LONGCARD;
  202. VAR
  203.   event  : InputEventPtr;
  204.   copy   : InputEvent;
  205.   buffer : ARRAY [0..5] OF CHAR;
  206. BEGIN
  207.   SAVEREGS({2..7,10,11,14});
  208.  
  209.   event:=ADDRESS(REGISTER(8));
  210.   copy := event^;
  211.  
  212.   (* See if timeout expired *)
  213.   IF (copy.ieClass=IEClassTimer) THEN
  214.     (* Who needs steenking microseconds? *)
  215.     IF ((copy.ieTimeStamp.tvSecs - ourtime.tvSecs) > timeout) THEN
  216.       Signal(maintask,SignalSet{sigbit});
  217.       ourtime := copy.ieTimeStamp;
  218.     END;
  219.  
  220.   (* Check for exit key *)
  221.   ELSIF (copy.ieClass=IEClassRawKey) AND (IEQualifierRShift IN copy.ieQualifier) AND
  222.       (IEQualifierRAlt IN copy.ieQualifier) THEN
  223.     copy.ieQualifier := copy.ieQualifier - IEQualifierSet{IEQualifierRShift,IEQualifierRAlt};
  224.     IF RawKeyConvert(ADR(copy),ADR(buffer),5,NIL)>0 THEN
  225.       IF buffer[0]="x" THEN
  226.         Signal(maintask,SignalSet{sigbit2});
  227.         event:=NIL;
  228.       END;
  229.     END;
  230.     ourtime := copy.ieTimeStamp;
  231.  
  232.   (* Otherwise, set start of timeout again *)
  233.   ELSIF (copy.ieClass IN IEClassSet{IEClassRawKey,IEClassRawMouse,IEClassPointerPos}) THEN
  234.     (* Apparently Snipit doesn't timestamp it's faked events, it
  235.      * sets them to 0.  Therefore, we gotta put a check in here for 0.
  236.      * Yeesh.
  237.      *)
  238.     IF copy.ieTimeStamp.tvSecs # 0 THEN
  239.       ourtime := copy.ieTimeStamp;
  240.     END;
  241.   END;
  242.  
  243.   LOADREGS({2..7,10,11,14});
  244.   RETURN LONGCARD(event);
  245. END InputHandler;
  246.  
  247. PROCEDURE AddInputHandler();
  248. VAR
  249.   x : INTEGER;
  250. BEGIN
  251.   CurrentTime(ourtime.tvSecs,ourtime.tvMicro);
  252.   port:=CreatePort(ADR(PORTNAME),0);
  253.   IF port # NIL THEN
  254.     ioreq.ioMessage.mnReplyPort:=port;
  255.     WITH int DO
  256.       isNode.lnPri:=BYTE(75);
  257.       isCode:=InputHandler;
  258.       isNode.lnName := ADR("* Blank_Handler");
  259.     END;
  260.     IF OpenDevice(ADR("input.device"),0,ADR(ioreq),LONGBITSET{})=0 THEN
  261.       ioreq.ioCommand:=INDAddHandler;
  262.       ioreq.ioData:=ADR(int);
  263.       x:=DoIO(ADR(ioreq));
  264.     END;
  265.   END;
  266. END AddInputHandler;
  267.  
  268.  
  269. PROCEDURE RemInputHandler;
  270. VAR
  271.   x : INTEGER;
  272. BEGIN
  273.   ioreq.ioCommand:=INDRemHandler;
  274.   ioreq.ioData:=ADR(int);
  275.   x:=DoIO(ADR(ioreq));
  276.   CloseDevice(ADR(ioreq));
  277.   DeletePort(port);
  278. END RemInputHandler;
  279.  
  280. PROCEDURE ControlLoop;
  281. VAR
  282.   wakeup : SignalSet;
  283.   error  : CARDINAL;
  284.   
  285. BEGIN
  286.   sigbit:=AllocSignal(-1);
  287.   sigbit2:=AllocSignal(-1);
  288.   AddInputHandler();
  289.  
  290.   LOOP
  291.     wakeup:=Wait(SignalSet{SIGBreakC,sigbit,sigbit2});
  292.  
  293.     IF sigbit IN wakeup THEN
  294.       RemInputHandler();
  295.       DoStarBlank();      (* Or insert your own function here *)
  296.       AddInputHandler();
  297.     ELSE
  298.       EXIT;
  299.     END;
  300.   END;
  301.  
  302.   RemInputHandler();
  303.   FreeSignal(sigbit2);
  304.   FreeSignal(sigbit);
  305.  
  306. END ControlLoop;
  307.  
  308. BEGIN
  309.   port := FindPort(ADR(PORTNAME));
  310.   IF (port = NIL) THEN
  311.     (* We aren't running yet *)
  312.     IF OpenDevice(ADR(ConsoleName),-1,ADR(iostdreq),LONGBITSET{})=0 THEN
  313.       Startup();
  314.       SayMessage("StarBlanker v1.00 installed");
  315.       ConsoleBase:=iostdreq.ioDevice;
  316.       maintask:=CurrentProcess;
  317.       ControlLoop;
  318.       CloseDevice(ADR(iostdreq));
  319.       SayMessage("StarBlanker removed");
  320.     END;
  321.   ELSE
  322.     (* We are already running *) 
  323.     Signal(port^.mpSigTask,SignalSet{SIGBreakC});
  324.   END;
  325.  
  326. END Blanker.
  327.